Problem antialiasingem
Otázka od: Michal Adler
30. 11. 2003 11:07
Zdravim vsechny,
potreboval bych poradit od nekoho kdo dela(l) nekdy neco s grafikou v
Delphi.
Potrebuji z obrazku udelat jeho zmenseninu v nejakem pomeru treba 1:2
(tohle neni problem). Prepocitat velikost bitmapy a ulozit ji umim.
Problem je, ze ty vysledne obrazky jsou takove kostrbate proste
nevypadaji tak dobre jako kdyz si je zmensim treba ve photoshopu nebo
jinem programu. Potrebuji tedy dodelat neco jako "vyhlazovani"
vysledne grafiky.
Pokud nekdo vite jak na to, nebo vite o nejake free komponente, ktera
tohle zvladne budu strasne vdecnej. Uplne nejlepsi by byl nejaky
utrzek kodu do mailu... 
predem moc dekuji
Michal Adler
Odpovedá: Vaclav Sazima
30. 11. 2003 15:28
Ahoj,
pod NT,2000,XP jednoduse :
SetStretchBltMode(Image.Picture.Bitmap.Canvas.Handle, HALFTONE);
StretchOK := StretchBlt(Image.Picture.Bitmap.Canvas.Handle....
Pod win9x je treba to zajistit samostatne, casto to je soucasti ruznych
grafickych knihoven, napr. Envision library, hledej treba slovo
bilinear. Jinak filtru, ktere odstranuji zubatost, je rada a vysledky se
lisi podle toho, co je na puvodnim obrazku.
Vaclav Sazima
Michal Adler wrote:
> Potrebuji z obrazku udelat jeho zmenseninu v nejakem pomeru treba 1:2
> (tohle neni problem). Prepocitat velikost bitmapy a ulozit ji umim.
> Problem je, ze ty vysledne obrazky jsou takove kostrbate proste
> nevypadaji tak dobre jako kdyz si je zmensim treba ve photoshopu nebo
> jinem programu. Potrebuji tedy dodelat neco jako "vyhlazovani"
> vysledne grafiky.
Odpovedá: Ondrej
30. 11. 2003 20:15
mozem ti poslat aj cely program, ak mi povies kde. inak tu je presne to co
potrebujes. je to vypis programu, nie vseobecny unit:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;
type
TForm1 = class(TForm)
Button1: TButton;
Image3: TImage;
Button3: TButton;
Button4: TButton;
ScrollBox1: TScrollBox;
Image2: TImage;
ScrollBox2: TScrollBox;
Image1: TImage;
BitBtn1: TBitBtn;
Label1: TLabel;
Label2: TLabel;
CheckBox1: TCheckBox;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
pRGBArray = ^TRGBArray;
TRGBArray = ARRAY[0..high(smallint)] OF TRGBTriple;
var
Form1: TForm1;
zoom:boolean=false;
const z=3;
implementation
{$R *.DFM}
procedure TForm1.Button2Click(Sender: TObject);
begin
Close;
end;
procedure FastAntiAlias;
var
x, y, j,i, totr, totg, totb: integer;
big_bmp, out_bmp : TBitmap;
cx, cy : integer;
Row1, Row2, Row3, DestRow: pRGBArray;
sirka,vyska:integer;
begin
{omlouvam se za dlouhou proceduru, ale to jinak udelat neslo
je to proste rutina, ktera se neda volat od nikud jinud}
sirka:=form1.Image1.Width;
vyska:=form1.Image1.Height;
// vytvoreni pomocne bitmapy k presamplovani do vyssiho rozliseni
big_bmp := TBitmap.Create;
big_bmp.Width := sirka*z;
big_bmp.Height := vyska*z;
big_bmp.PixelFormat := pf24bit;
big_bmp.Canvas.Draw(0,0,form1.image3.Picture.Bitmap);
file://Vytvoreni vystupni bitmapy
out_bmp := TBitmap.Create;
out_bmp.Width := sirka;
out_bmp.Height := vyska;
out_bmp.PixelFormat := pf24bit;
// pro vsechny radky
for y := 0 to vyska - 1 do
begin
// spocitam vzorek 3 x 3 pixels
cy := y*z;
// Vezmu body od aktualniho, predchziho a nasledujYcYho sloupce v
presamplovane bitmape
Row1 := big_bmp.ScanLine[cy];
Row2 := big_bmp.ScanLine[cy+1];
Row3 := big_bmp.ScanLine[cy+2];
// Vezmu ukazatel na sloupec y
DestRow := out_bmp.ScanLine[y];
file://pro vsechny radky
for x := 0 to sirka - 1 do
begin
// zpracuju vzorky z 3 x 3 pixelu
cx := x*z;
// icializace vysledne barvy
totr := 0;
totg := 0;
totb := 0;
// Pro vsechny pxely ve vzorku
for i:=0 to 2 do
begin
// nova hodnota cervene
totr := totr + Row1[cx + i].rgbtRed
+ Row2[cx + i].rgbtRed
+ Row3[cx + i].rgbtRed;
// nova hodnota zelene
totg := totg + Row1[cx + i].rgbtGreen
+ Row2[cx + i].rgbtGreen
+ Row3[cx + i].rgbtGreen;
// nova hodnota modre
totb := totb + Row1[cx + i].rgbtBlue
+ Row2[cx + i].rgbtBlue
+ Row3[cx + i].rgbtBlue;
end;
// nastaveni vyslednych pixelu
DestRow[x].rgbtRed := totr div 9;
DestRow[x].rgbtGreen := totg div 9;
DestRow[x].rgbtBlue := totb div 9;
end;
end;
form1.Image2.canvas.Draw(0,0,out_bmp);//zkopirovani vysledne bitmapy
file://uvolneni vsech pomocnych bitmap
big_bmp.free;
out_bmp.free;
End;
procedure SeparateColor(color : TColor; var r, g, b : Integer);
begin
r := Byte(color);
g := Byte(color shr 8);
b := Byte(color shr 16);
end;
procedure AntiAliasing;
var
x, y: integer;
totr, totg, totb, r, g, b : integer;
i, j: integer;
begin
file://pro vUechny ??dky
for y := 0 to form1.image1.Height - 1 do
begin
Application.ProcessMessages; // nech aplikaci vykreslit se po ?adcYch
file://pro vUechny sloupce
for x := 0 to form1.image1.Width - 1 do
begin
totr := 0; file://inicializuj barvu
totg := 0;
totb := 0;
// p?eRti barvu ze vUech okolnich pixelu
for i := 0 to 2 do
begin
for j := 0 to 2 do
begin
SeparateColor(form1.image3.Canvas.Pixels[(x*z) + j, (y*z) + i], r,
g, b); file://oddyl barevnU so?ky
totr := totr + r; file://p?iRti p?Yspyvek u ka?dU slo?ky zvlaUL
totg := totg + g;
totb := totb + b;
end;
end;
form1.image2.Canvas.Pixels[x,y] := RGB(totr div 9, file://nakresli
vyslednou barvu podylenou 9
totg div 9,
totb div 9);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var cas:integer;
begin
Image2.Canvas.FillRect(Image2.Canvas.ClipRect);
Application.ProcessMessages;
cas:=GetTickCount;
form1.Enabled:=false;
if CheckBox1.Checked then
FastAntiAlias
else
AntiAliasing;
cas:=GetTickCount-cas;
form1.Enabled:=true;
label2.caption:=floattostr(cas/1000)+'s';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
image2.Canvas.FillRect(Image2.Canvas.ClipRect);
with image1.canvas do
begin
Pen.Width:=3;
FillRect(Image1.Canvas.ClipRect);
Brush.Color:=clyellow;
Ellipse(1,1,image1.Width-1,Image1.Height-1);
LineTo(image1.Width,image1.Height);
MoveTo(image1.Width,0);
lineto(0,image1.Height);
end;
image1.Canvas.Font.Size := 30;
image1.Canvas.Font.Name := 'Arial';
image1.Canvas.TextOut(10,100,'Ondrej 2003');
image3.width:=image1.Width*z;
image3.Height:=image1.Height*z;
with image3.canvas do
begin
Pen.Width:=3*z;
FillRect(Image3.Canvas.ClipRect);
Brush.Color:=clyellow;
Ellipse(z,z,image3.Width-z,image3.Height-z);
LineTo(image1.Width*z,image1.Height*z);
MoveTo(image1.Width*z,0);
lineto(0,image1.Height*z);
end;
image3.Canvas.Font.Size := 90;
image3.Canvas.Font.Name := 'Arial';
image3.Canvas.TextOut(3*10,3*100,'Ondrej 2003');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if not zoom then
begin
Image1.Width:=Image1.Width*3;
Image1.height:=Image1.Height*3;
Image2.Width:=Image2.Width*3;
Image2.height:=Image2.Height*3;
zoom:=true;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if zoom then
begin
Image1.Width:=Image1.Width div 3;
Image1.height:=Image1.Height div 3;
Image2.Width:=Image2.Width div 3;
Image2.height:=Image2.Height div 3;
zoom:=false;
end;
end;
end.
----- Original Message -----
From: "Michal Adler" <michal.adler@fotoadler.cz>
To: <delphi-l@clexpert.cz>
Sent: Sunday, November 30, 2003 11:05 AM
Subject: Problem antialiasingem
> Zdravim vsechny,
> potreboval bych poradit od nekoho kdo dela(l) nekdy neco s grafikou v
> Delphi.
>
> Potrebuji z obrazku udelat jeho zmenseninu v nejakem pomeru treba 1:2
> (tohle neni problem). Prepocitat velikost bitmapy a ulozit ji umim.
> Problem je, ze ty vysledne obrazky jsou takove kostrbate proste
> nevypadaji tak dobre jako kdyz si je zmensim treba ve photoshopu nebo
> jinem programu. Potrebuji tedy dodelat neco jako "vyhlazovani"
> vysledne grafiky.
>
> Pokud nekdo vite jak na to, nebo vite o nejake free komponente, ktera
> tohle zvladne budu strasne vdecnej. Uplne nejlepsi by byl nejaky
> utrzek kodu do mailu...
>
> predem moc dekuji
> Michal Adler
>
>
>
>